home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / CD_UTIL / CDPLAY / CD.PAS next >
Pascal/Delphi Source File  |  1992-12-09  |  13KB  |  495 lines
  1.       {******************************************************************}
  2.       {   Source File: CD.pas                                            }
  3.       {   Unit File: CDC.Pas                                             }
  4.       {   Resource File: CD.Res                                          }
  5.       {   Description: Pascal Source file for CD Player                  }
  6.       {   Date:        Fri Dec 04 19:45:57 1992                          }
  7.       {   Copyright 1992 by M. W. Armstrong                              }
  8.       {******************************************************************}
  9.  
  10. {$X+}
  11.  
  12. program CD;
  13.  
  14. {$R CD.RES}
  15.  
  16. uses
  17.    WinProcs, WinTypes, Objects, OWindows, OMemory,
  18.    ODialogs, Strings, bwcc, MMSystem, CDC;
  19.  
  20. const
  21.    AppName: PChar = 'CD';
  22.  
  23.    Shuffle      = 102;
  24.    RepeatSong   = 103;
  25.    CDPlay       = 104;
  26.    CDStop       = 105;
  27.    Rewind       = 106;
  28.    FastForward  = 107;
  29.    CDPause      = 108;
  30.    CDEject      = 109;
  31.    CDLoud       = 113;
  32.    CDStereoE    = 114;
  33.    CDReverb     = 115;
  34.  
  35. type
  36.  
  37. {--------------- Main Window Object ---------------}
  38.  
  39.    PCD = ^TCD;
  40.    TCD = object(TApplication)
  41.       procedure   InitMainWindow; virtual;
  42.    end;
  43.  
  44. {--------------- Main Window Dialog of the application -------------------}
  45.  
  46.   PMainWindow = ^TMainWindow;
  47.   TMainWindow = object(TDlgWindow)
  48.     VLeft,
  49.     VRight,
  50.     BassBar,
  51.     TrebBar,
  52.     MidBar  : PScrollBar;
  53.     RepeatBtn,
  54.     ShuffleBtn : PRadioButton;
  55.     LoudBtn,
  56.     StereoBtn,
  57.     ReverbBtn : PCheckBox;
  58.     TotTime,
  59.     SongTime,
  60.     CurTrack  : PStatic;
  61.     procedure Play;
  62.     procedure OpenDevices;
  63.     procedure SetUpCD;
  64.     procedure DefChildProc(var Msg: TMessage); virtual;
  65.     procedure CDBass(var Msg : TMessage);
  66.       virtual id_first + 110;
  67.     procedure CDMidrange(var Msg : TMessage);
  68.       virtual id_first + 111;
  69.     procedure CDTreble(var Msg : TMessage);
  70.       virtual id_first + 112;
  71.     procedure CDVLeft(var Msg : TMessage);
  72.       virtual id_first + 117;
  73.     procedure CDVRight(var Msg : TMessage);
  74.       virtual id_first + 118;
  75.     procedure Notify(var Msg : TMessage);
  76.       virtual MCI_Notify;
  77.     procedure TUpDate(var Msg: TMessage);
  78.        virtual wm_Timer;
  79.     procedure CheckCD;
  80.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  81.     destructor Done; virtual;
  82.     procedure SetupWindow; virtual;
  83.     private
  84.       TimerId: word;
  85.   end;
  86.  
  87. var
  88.   Tracks : Array[0..99] of Integer;
  89.   TrackLen : Array[0..99] of TrackRecord;
  90.   NowPlaying,
  91.   TotalMin,
  92.   TotalSec : Integer;
  93.   TotalPlay,
  94.   SongPlay,
  95.   StartPos,
  96.   CurPos,
  97.   SongPos,
  98.   TMSF       : TimeTMSF;
  99.   CDError,
  100.   EndOfList,
  101.   Repeating,
  102.   Shuffled   : Boolean;
  103.  
  104. { Initialize CD Dialog and install controls }
  105.  
  106. constructor TMainWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  107. begin
  108.    inherited Init(AParent, ATitle);
  109.    BassBar := New(PScrollBar, InitResource(@Self, 110));
  110.    MidBar  := New(PScrollBar, InitResource(@Self, 111));
  111.    TrebBar := New(PScrollBar, InitResource(@Self, 112));
  112.    VLeft   := New(PScrollBar, InitResource(@Self, 117));
  113.    VRight  := New(PScrollBar, InitResource(@Self, 118));
  114.  
  115.    LoudBtn   := New(PCheckBox, InitResource(@Self, 113));
  116.    StereoBtn := New(PCheckBox, InitResource(@Self, 114));
  117.    ReverbBtn := New(PCheckBox, InitResource(@Self, 115));
  118.  
  119.    ShuffleBtn := New(PRadioButton, InitResource(@Self, 120));
  120.    RepeatBtn  := New(PRadioButton, InitResource(@Self, 121));
  121.  
  122.    TotTime  := New(PStatic, InitResource(@Self, 201, 7));
  123.    SongTime := New(PStatic, InitResource(@Self, 202, 7));
  124.    CurTrack := New(PStatic, InitResource(@Self, 203, 3));
  125.  
  126. end;
  127.  
  128. { Sets timer for UpDate procedure }
  129.  
  130. procedure TMainWindow.SetupWindow;
  131. begin
  132.    inherited SetupWindow;
  133.    OpenDevices;
  134.    SetUpCD;
  135.    TimerId := SetTimer( HWindow, 1, 1000, Nil);
  136. end;
  137.  
  138. procedure TMainWindow.OpenDevices;
  139. begin
  140.    WinHandle := HWindow;
  141.    MixerAvail := OpenMixer;
  142.    CDAvail := OpenCD;
  143.    SetTMSF;
  144. end;
  145.  
  146. { Reads information from MCI for CD tracks }
  147.  
  148. procedure TMainWindow.SetUpCD;
  149. var I : integer;
  150. begin
  151.    Randomize;
  152.    FillChar(Tracks, SizeOf(Tracks), 0);
  153.    NumTracks := 0;
  154.    If (CDAvail) THEN
  155.    Begin
  156.       StopCD;
  157.       For NumTracks := 1 to NumberOfTracks DO
  158.           Tracks[NumTracks] := NumTracks;
  159.       ConvTMSF(StartPos, StartCD);
  160.  
  161.       For I := 1 to Numtracks DO
  162.       Begin
  163.         ConvMSF(SongPlay, LengthTrack(I));
  164.         ConvMSF(SongPos, StartTrack(I));
  165.         TrackLen[I].Minutes := SongPlay.Minutes;
  166.         TrackLen[I].Seconds := SongPlay.Seconds;
  167.         TrackLen[I].Frames  := SongPlay.Frames;
  168.         TrackLen[I].StartMin := SongPos.Minutes;
  169.         TrackLen[I].StartSec := SongPos.Seconds;
  170.         TrackLen[I].StartFrame  := SongPos.Frames;
  171.       End;
  172.       CDError := FALSE;
  173.    End
  174.    ELSE
  175.    Begin
  176.      CDError := TRUE;
  177.    End;
  178.    NowPlaying := 0;
  179.    Shuffled := FALSE;
  180.    EndOfList := FALSE;
  181.    Repeating := FALSE;
  182.  
  183.    BassBar^.SetRange(0, 100);
  184.    MidBar^.SetRange(0, 100);
  185.    TrebBar^.SetRange(0, 100);
  186.    VLeft^.SetRange(0, 100);
  187.    VRight^.SetRange(0, 100);
  188.  
  189.    BassBar^.SetPosition(95);
  190.    Bass(95);
  191.    MidBar^.SetPosition(50);
  192.    MidRange(50);
  193.    TrebBar^.SetPosition(95);
  194.    Treble(95);
  195.    VLeft^.SetPosition(35);
  196.    Volume('left', 35);
  197.    VRight^.SetPosition(35);
  198.    Volume('right', 35);
  199.  
  200.    If (Loudness(-101) = 0) THEN
  201.       LoudBtn^.SetCheck(0)
  202.    ELSE
  203.       LoudBtn^.SetCheck(1);
  204.  
  205.    If (Reverb(-101) = 0) THEN
  206.       ReverbBtn^.SetCheck(0)
  207.    ELSE
  208.       ReverbBtn^.SetCheck(1);
  209.  
  210.    If (StereoEnhance(-101) = 0) THEN
  211.       StereoBtn^.SetCheck(0)
  212.    ELSE
  213.       StereoBtn^.SetCheck(1);
  214.  
  215. end;
  216.  
  217. {------------- Main Window Destructor ---------}
  218.  
  219. destructor TMainWindow.Done;
  220. begin
  221.    KillTimer( 0, TimerId);
  222.    CloseCD;
  223.    CloseMixer;
  224.  
  225.    inherited Done;
  226. end;
  227.  
  228. { Handles the buttons on the CD Dialog }
  229.  
  230. procedure TMainWindow.DefChildProc(var Msg: TMessage);
  231. var
  232.   I, J : Integer;
  233. begin
  234.   if (Msg.WParamHi = 0) and (Msg.LParamHi = bn_Clicked) then
  235.   Case Msg.WParamLo OF
  236.        Shuffle :
  237.                begin
  238.                  If Shuffled THEN
  239.                  Begin
  240.                     For NumTracks := 1 to NumberOfTracks DO
  241.                         Tracks[NumTracks] := NumTracks;
  242.                     ShuffleBtn^.SetCheck(0);
  243.                  End
  244.                  ELSE
  245.                  Begin
  246.                    I := 2;
  247.                    Tracks[1] := Random(NumTracks) + 1;;
  248.                    Repeat
  249.                      Tracks[I] := Random(NumTracks) + 1;
  250.                      J := 1;
  251.                      Repeat
  252.                        If Tracks[J] = Tracks[I] THEN
  253.                           Tracks[I] := Random(NumTracks) + 1
  254.                        ELSE
  255.                           Inc(J);
  256.                      Until (J = I);
  257.                      Inc(I);
  258.                    Until (I > NumTracks);
  259.                    ShuffleBtn^.SetCheck(1);
  260.                  end;
  261.                  Shuffled := NOT Shuffled;
  262.                end;
  263.        RepeatSong :
  264.                begin
  265.                  Repeating := NOT Repeating;
  266.                  If Repeating THEN
  267.                  Begin
  268.                    If NowPlaying > 0 THEN
  269.                       Dec(NowPlaying);
  270.                    Repeating := TRUE;
  271.                    RepeatBtn^.SetCheck(1);
  272.                  End
  273.                  ELSE
  274.                    RepeatBtn^.SetCheck(0);
  275.                end;
  276.        CDStop : StopCD;
  277.        Rewind :
  278.                begin
  279.                  If NowPlaying > 1 THEN
  280.                     Dec(NowPlaying, 2);
  281.                  Play;
  282.                end;
  283.        CDPlay: Begin
  284.                  Play;
  285.                End;
  286.        FastForward : Play;
  287.        CDPause :
  288.                Begin
  289.                  PauseCD;
  290.                  Paused := TRUE;
  291.                end;
  292.        CDEject : EjectCD;
  293.        CDLoud :
  294.                begin
  295.                  If LoudBtn^.GetCheck = bf_Unchecked then
  296.                     Loudness(-1)
  297.                  ELSE
  298.                     Loudness(1);
  299.                  end;
  300.        CDStereoE :
  301.                  begin
  302.                    If StereoBtn^.GetCheck = bf_Unchecked then
  303.                       StereoEnhance(-1)
  304.                    ELSE
  305.                       StereoEnhance(1);
  306.                  end;
  307.        CDReverb :
  308.                  begin
  309.                    If ReverbBtn^.GetCheck = bf_Unchecked then
  310.                       Reverb(-1)
  311.                    ELSE
  312.                       Reverb(1);
  313.                  end;
  314.    end; { Case }
  315.   TDlgWindow.DefChildProc(Msg);
  316. end;
  317.  
  318. { MCI notifies the program when any changes to the 'OPEN' status of the CD
  319.   or the 'PLAY' status have occured }
  320.  
  321. procedure TMainWindow.Notify(var Msg : TMessage);
  322. begin
  323.   Case Msg.wParam OF
  324.        MCI_Notify_Successful : If NOT EndOfList THEN Play;
  325.        MCI_Notify_Failure    :
  326.                              Begin
  327.                                MessageBox(HWindow, 'The CD Player has stopped',
  328.                                           'Check your CD', mb_OK);
  329.                                CDError := TRUE;
  330.                              End;
  331.   End; { Case }
  332. end;
  333.  
  334. procedure TMainWindow.CheckCD;
  335. begin
  336.   If MediaPresent AND Ready THEN
  337.      SetUpCD;
  338. end;
  339.  
  340. { The following procedures set the mixer's levels }
  341.  
  342. procedure TMainWindow.CDBass(var Msg : TMessage);
  343. Begin
  344.   Bass(BassBar^.GetPosition);
  345. End;
  346.  
  347. procedure TMainWindow.CDMidrange(var Msg : TMessage);
  348. Begin
  349.   MidRange(MidBar^.GetPosition);
  350. End;
  351.  
  352. procedure TMainWindow.CDTreble(var Msg : TMessage);
  353. Begin
  354.   Treble(TrebBar^.GetPosition);
  355. End;
  356.  
  357. procedure TMainWindow.CDVLeft(var Msg : TMessage);
  358. Begin
  359.   Volume('left', VLeft^.GetPosition);
  360.   Volume('right', Vright^.GetPosition);
  361. End;
  362.  
  363. procedure TMainWindow.CDVRight(var Msg : TMessage);
  364. Begin
  365.   Volume('left', VLeft^.GetPosition);
  366.   Volume('right', Vright^.GetPosition);
  367. End;
  368.  
  369. { This procedure plays the next track.  If all tracks have been played,
  370.   it does nothing until the play button has been pressed again }
  371.  
  372. procedure TMainWindow.Play;
  373. var
  374.   CStr : String[3];
  375.   SStr : PChar;
  376.   I    : Integer;
  377. begin
  378.   If Repeating THEN
  379.      Begin
  380.        RepeatBtn^.SetCheck(0);
  381.        Repeating := FALSE;
  382.      End;
  383.   If Paused THEN
  384.      ResumeCD
  385.   ELSE
  386.   Begin
  387.     If Tracks[NowPlaying + 1] <> 0 THEN
  388.     Begin
  389.        REPEAT
  390.          Inc(NowPlaying);
  391.        UNTIL ( PlayCD(Tracks[NowPlaying], 0) OR (NowPlaying = NumTracks));
  392.        Str(Tracks[NowPlaying], CStr);
  393.        GetMem(SStr, 5);
  394.        StrPCopy(SStr, CStr);
  395.        CurTrack^.SetText(SStr);
  396.        FreeMem(SStr, 5);
  397.        TotalMin := 0;
  398.        TotalSec := 0;
  399.        For I := NowPlaying TO NumTracks DO
  400.            Begin
  401.              TotalMin := TotalMin + TrackLen[I].Minutes;
  402.              TotalSec := TotalSec + TrackLen[I].Seconds;
  403.            End;
  404.        TotalMin := TotalMin + (TotalSec DIV 60);
  405.        TotalSec := TotalSec MOD 60;
  406.        EndOfList := FALSE;
  407.     End
  408.   ELSE
  409.     EndofList := TRUE;
  410.   End;
  411.   Paused := FALSE;
  412. end;
  413.  
  414. { Converts Minute and Second display to a string }
  415.  
  416. function TimeString(Min, Sec, MLen : Integer) : String;
  417. var
  418.   MStr,
  419.   SStr : String[3];
  420. begin
  421.   Str(Min, MStr);
  422.   While Length(MStr) < MLen DO
  423.     MStr := '0' + MStr;
  424.  
  425.   Str(Sec, SStr);
  426.   While Length(SStr) < 2 DO
  427.     SStr := '0' + SStr;
  428.  
  429.   TimeString := MStr + ':' + SStr;
  430. End;
  431.  
  432. { This procedure updates the Time displays.  It is called approximately
  433.   once each second by the Windows SetTimer callback function }
  434.  
  435. procedure TMainWindow.TUpDate;
  436. var
  437.   TStr,
  438.   SStr : String[10];
  439.   ShowStr : PChar;
  440.   I,
  441.   Min,
  442.   Sec : Integer;
  443. begin
  444.  
  445.   If CDError THEN CheckCD
  446.   ELSE
  447.   Begin
  448.  
  449.     Min := 0;
  450.     Sec := 0;
  451.  
  452.     ConvTMSF(SongPlay, Position);
  453.  
  454.     Min := (TotalMin *60) + TotalSec;
  455.     Sec := (SongPlay.Minutes * 60) + SongPlay.Seconds;
  456.     Min := Abs(Min - Sec);
  457.     Sec := Min;
  458.     Min := Min DIV 60;
  459.     Sec := Sec MOD 60;
  460.  
  461.     GetMem(ShowStr, 10);
  462.     StrPCopy(ShowStr, TimeString(Min, Sec, 3));
  463.     TotTime^.SetText(ShowStr);
  464.  
  465.     Min := (SongPlay.Minutes *60) + SongPlay.Seconds;
  466.     Sec := (TrackLen[Tracks[NowPlaying]].Minutes * 60) +
  467.             TrackLen[Tracks[NowPlaying]].Seconds;
  468.     Min := Abs(Min - Sec);
  469.     Sec := Min;
  470.     Min := Min DIV 60;
  471.     Sec := Sec MOD 60;
  472.  
  473.     StrPCopy(ShowStr, TimeString(Min, Sec, 2));
  474.     SongTime^.SetText(ShowStr);
  475.  
  476.     FreeMem(ShowStr, 10);
  477.   end;
  478. end;
  479.  
  480. { Create the application's main window }
  481.  
  482. procedure TCD.InitMainWindow;
  483. begin
  484.    MainWindow := New(PMainWindow, Init(nil, 'DIALOG_1'));
  485. end;
  486.  
  487. var
  488.   MainApp: TCD;
  489.  
  490. begin
  491.    MainApp.Init('CD');
  492.    MainApp.Run;
  493.    MainApp.Done;
  494. end.
  495.